Data Overview

readr::read_csv(here("data/character_list5.csv"),
                      progress = FALSE,
                      col_types = cols(
                                    script_id = col_integer(),
                                    imdb_character_name = col_character(),
                                    words = col_integer(),
                                    gender = col_character(),
                                    age = col_character()
                                    )) %>%
  mutate(age = as.numeric(age)) -> characters_list
characters_list %>% 
  glimpse()
Observations: 23,048
Variables: 5
$ script_id           <int> 280, 280, 280, 280, 280, 280, 280, 623, 623, 623, 623, 623, 623, 623...
$ imdb_character_name <chr> "betty", "carolyn johnson", "eleanor", "francesca johns", "madge", "...
$ words               <int> 311, 873, 138, 2251, 190, 723, 1908, 328, 409, 347, 2020, 366, 160, ...
$ gender              <chr> "f", "f", "f", "f", "f", "m", "m", "m", "f", "m", "m", "m", "m", "m"...
$ age                 <dbl> 35, NA, NA, 46, 46, 38, 65, NA, 28, NA, 58, 53, 25, 39, 33, NA, 34, ...
readr::read_csv(here("data/meta_data7.csv"),
                      progress = FALSE,
         col_types = cols(
                        script_id = col_integer(),
                        imdb_id = col_character(),
                        title = col_character(),
                        year = col_integer(),
                        gross = col_integer(),
                        lines_data = col_character()
                        )) %>%
  mutate(title = iconv(title,"latin1", "UTF-8")) -> meta_data
meta_data %>%
  glimpse()
Observations: 2,000
Variables: 6
$ script_id  <int> 1534, 1512, 1514, 1517, 1520, 6537, 3778, 623, 1525, 6030, 625, 1509, 8543, 7...
$ imdb_id    <chr> "tt1022603", "tt0147800", "tt0417385", "tt2024544", "tt1542344", "tt0450385",...
$ title      <chr> "(500) Days of Summer", "10 Things I Hate About You", "12 and Holding", "12 Y...
$ year       <int> 2009, 1999, 2005, 2013, 2010, 2007, 1992, 2001, 2009, 2013, 1968, 2009, 2008,...
$ gross      <int> 37, 65, NA, 60, 20, 91, 15, 37, 74, 80, 376, 192, 98, 204, 19, 59, 67, 36, 32...
$ lines_data <chr> "7435445256774774443342577775657744434444564456745433675534527777342375445534...

Combinando Dados Originais

left_join(characters_list, 
          meta_data, 
          by=c("script_id")) %>%
  group_by(title, year) %>%
  drop_na(gross) %>%
  ungroup() -> scripts_data
scripts_data %>%
  glimpse()
Observations: 19,387
Variables: 10
$ script_id           <int> 280, 280, 280, 280, 280, 280, 280, 623, 623, 623, 623, 623, 623, 623...
$ imdb_character_name <chr> "betty", "carolyn johnson", "eleanor", "francesca johns", "madge", "...
$ words               <int> 311, 873, 138, 2251, 190, 723, 1908, 328, 409, 347, 2020, 366, 160, ...
$ gender              <chr> "f", "f", "f", "f", "f", "m", "m", "m", "f", "m", "m", "m", "m", "m"...
$ age                 <dbl> 35, NA, NA, 46, 46, 38, 65, NA, 28, NA, 58, 53, 25, 39, 33, NA, 34, ...
$ imdb_id             <chr> "tt0112579", "tt0112579", "tt0112579", "tt0112579", "tt0112579", "tt...
$ title               <chr> "The Bridges of Madison County", "The Bridges of Madison County", "T...
$ year                <int> 1995, 1995, 1995, 1995, 1995, 1995, 1995, 2001, 2001, 2001, 2001, 20...
$ gross               <int> 142, 142, 142, 142, 142, 142, 142, 37, 37, 37, 37, 37, 37, 37, 37, 3...
$ lines_data          <chr> "4332023434343443203433434334433434343434434344344333434443444344233...
scripts_data %>%
  mutate(fem_words = ifelse(gender == "f",words,0),
         man_words = ifelse(gender == "m",words,0)) %>%
  group_by(title, year) %>%
  mutate(total_fem_words = sum(fem_words),
         total_man_words = sum(man_words)) %>%
  filter(total_fem_words !=  0) %>%
  filter(total_man_words !=  0) %>%
    mutate(f_m_ratio = sum(gender == "f")/sum(gender == "m"),
           f_m_wordratio = total_fem_words/total_man_words) %>%
  ungroup()  -> scripts_data
scripts_data %>%
  select(title,
         year,
         f_m_ratio,
         f_m_wordratio) %>%
  sample_n(10)
summary(scripts_data$f_m_wordratio)

Female/Male Word Ratio

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x=f_m_wordratio,
             y=(..count..)/sum(..count..))) +
  geom_histogram(binwidth = 1,
                 boundary = 0,
                 fill = "grey",
                 color = "black")

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x="", 
             y=words)) +
  geom_violin(fill="grey",
               width=0.5)

Female/Male Ratio

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x=f_m_ratio,
             y=(..count..)/sum(..count..))) +
  geom_histogram(binwidth = 0.1,
                 boundary = 0,
                 fill = "grey",
                 color = "black")

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x="", 
             y=f_m_ratio)) +
  geom_violin(fill="grey",
               width=0.5)

Movie Year

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x=year)) +
  geom_bar(fill = "grey",
           color = "black")

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x="", 
             y=year)) +
  geom_violin(fill="grey",
               width=0.5)

Gross

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x=gross,
             y=(..count..)/sum(..count..))) +
  geom_histogram(binwidth = 50,
                 boundary = 0,
                 fill = "grey",
                 color = "black")

scripts_data %>%
  group_by(title,year) %>%
  unique() %>%
  ggplot(aes(x="", 
             y=gross)) +
  geom_violin(fill="grey",
               width=0.5)

Scaling Data

scripts_data %>%
  group_by(title) %>%
  slice(1) %>%
  unique() %>%
  ungroup() %>%
  select(title,
         gross,
         f_m_ratio,
         f_m_wordratio) -> data
select(data, -title) %>%
mutate_all(funs(scale)) -> scaled_data
scaled_data %>% 
  sample_n(10)

Número K ótimo

GAP statistic

A GAP compara a solução do agrupamento com cada k com a solução em um dataset onde não há estrutura de grupos.

plot_clusgap = function(clusgap, title="Gap Statistic calculation results"){
    require("ggplot2")
    gstab = data.frame(clusgap$Tab, k=1:nrow(clusgap$Tab))
    p = ggplot(gstab, aes(k, gap)) + geom_line() + geom_point(size=5)
    p = p + geom_errorbar(aes(ymax=gap+SE.sim, ymin=gap-SE.sim), width = .2)
    p = p + ggtitle(title)
    return(p)
}
gaps <- scaled_data %>% 
    clusGap(FUN = kmeans,
            nstart = 20,
            K.max = 8,
            B = 200,
            iter.max=30)
Clustering k = 1,2,..., K.max (= 8): .. done
Bootstrapping, b = 1,2,..., B (= 200)  [one "." per sample]:
.................................................. 50 
.................................................. 100 
.................................................. 150 
.................................................. 200 
plot_clusgap(gaps)

  • 3 ou 6 grupos parece apropiado, mas como 6 é precedido por uma série de quedas 3 seria uma melhor opção.

Elbow Method

set.seed(123)
# Compute and plot wss for k = 2 to k = 15.
k.max <- 15
wss <- sapply(1:k.max, 
              function(k){kmeans(scaled_data, k, nstart=50,iter.max = 15 )$tot.withinss})
plot(1:k.max, wss,
     type="b", pch = 19, frame = FALSE, 
     xlab="Number of clusters K",
     ylab="Total within-clusters sum of squares")

  • Pelo Elbow method 3 parece ser um bom número de grupos devido à queda de 3 para 4.

Bayesian Information Criterion

  • Visualmente K= 2 e K = 3 representam o ganho mais significativo em termos de BIC (Bayesian Information Criterion)

Hubert Index e D Index

nb <- NbClust(scaled_data, diss=NULL, distance = "euclidean", 
              min.nc=2, max.nc=5, method = "kmeans", 
              index = "all", alphaBeale = 0.1)
*** : The Hubert index is a graphical method of determining the number of clusters.
                In the plot of Hubert index, we seek a significant knee that corresponds to a 
                significant increase of the value of the measure i.e the significant peak in Hubert
                index second differences plot. 
 

*** : The D index is a graphical method of determining the number of clusters. 
                In the plot of D index, we seek a significant knee (the significant peak in Dindex
                second differences plot) that corresponds to a significant increase of the value of
                the measure. 
 
******************************************************************* 
* Among all indices:                                                
* 5 proposed 2 as the best number of clusters 
* 8 proposed 3 as the best number of clusters 
* 2 proposed 4 as the best number of clusters 
* 8 proposed 5 as the best number of clusters 

                   ***** Conclusion *****                            
 
* According to the majority rule, the best number of clusters is  3 
 
 
******************************************************************* 

hist(nb$Best.nc[1,], breaks = max(na.omit(nb$Best.nc[1,])))

  • O índice de Hubert e o índice D sugerem K = 3 como a melhor solução

K-Means


Clustering

n_clusters = 3
scaled_data %>%
    kmeans(n_clusters, iter.max = 100, nstart = 20) -> km
p <- autoplot(km, data=scaled_data, frame = TRUE)  
ggplotly(p)
  • É possível ver os 3 grupos nitidamente distintos, por meio de um zoom percebe-se que embora o grupo 1 e o grupo 3 estejam próximos o overlap é basicamente inexistente.
row.names(scaled_data) <- data$title
toclust <- scaled_data %>% 
    rownames_to_column(var = "title") 
km = toclust %>% 
    select(-title) %>% 
    kmeans(centers = n_clusters, iter.max = 100, nstart = 20)
km %>% 
    augment(toclust) %>% 
    gather(key = "variável", value = "valor", -title, -.cluster) %>% 
    ggplot(aes(x = `variável`, y = valor, group = title, colour = .cluster)) + 
    geom_point(alpha = 0.2) + 
    geom_line(alpha = .5) + 
    facet_wrap(~ .cluster) +
    coord_flip()

  • Grupo 1 Yes, We Can
    • Menor Faturamento
    • Mais dialógo para as mulheres
    • Maior taxa de personagens femininos
  • Grupo 2 - It’s a man’s world
    • Maior faturamento entre todos
    • Menor taxa de dialógo para as mulheres
    • Menor taxa de personagens femininos
  • Grupo 3 - Sitting on the Fence
    • Mediano em termos de dialógo, personagens e faturamento

Silhouette

dists = scaled_data %>% 
  dist()
scaled_data %>%
    kmeans(3, iter.max = 100, nstart = 20) -> km
silhouette(km$cluster, dists) %>%
   plot(col = RColorBrewer::brewer.pal(4, "Set2"),border=NA)

  • O valor de 0.6 da silhueta significa que a nossa clusterização foi razoável. ヾ(⌐■_■)ノ♪
LS0tCnRpdGxlOiAiTGluZSBkaXN0cmlidXRpb24gb24gY2luZW1hIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIGRmX3ByaW50OiBwYWdlZAogICAgdG9jOiB5ZXMKICAgIHRvY19mbG9hdDogeWVzCiAgaHRtbF9ub3RlYm9vazoKICAgIHRvYzogeWVzCiAgICB0b2NfZmxvYXQ6IHllcwotLS0KCgpgYGB7ciBzZXR1cCwgZWNobz1GQUxTRSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0KCmxpYnJhcnkoaGVyZSkKbGlicmFyeShicm9vbSkKbGlicmFyeSh2ZWdhbikKbGlicmFyeShtY2x1c3QpCmxpYnJhcnkocGxvdGx5KQpsaWJyYXJ5KE5iQ2x1c3QpCmxpYnJhcnkobGF0dGljZSkKbGlicmFyeShjbHVzdGVyKQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShnZ2ZvcnRpZnkpCgp0aGVtZV9zZXQodGhlbWVfYncoKSkKYGBgCgojIERhdGEgT3ZlcnZpZXcKCmBgYHtyLCB3YXJuaW5nPUZBTFNFfQpyZWFkcjo6cmVhZF9jc3YoaGVyZSgiZGF0YS9jaGFyYWN0ZXJfbGlzdDUuY3N2IiksCiAgICAgICAgICAgICAgICAgICAgICBwcm9ncmVzcyA9IEZBTFNFLAogICAgICAgICAgICAgICAgICAgICAgY29sX3R5cGVzID0gY29scygKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2NyaXB0X2lkID0gY29sX2ludGVnZXIoKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgaW1kYl9jaGFyYWN0ZXJfbmFtZSA9IGNvbF9jaGFyYWN0ZXIoKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgd29yZHMgPSBjb2xfaW50ZWdlcigpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBnZW5kZXIgPSBjb2xfY2hhcmFjdGVyKCksCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGFnZSA9IGNvbF9jaGFyYWN0ZXIoKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICApKSAlPiUKICBtdXRhdGUoYWdlID0gYXMubnVtZXJpYyhhZ2UpKSAtPiBjaGFyYWN0ZXJzX2xpc3QKCmNoYXJhY3RlcnNfbGlzdCAlPiUgCiAgZ2xpbXBzZSgpCgpgYGAKCmBgYHtyfQpyZWFkcjo6cmVhZF9jc3YoaGVyZSgiZGF0YS9tZXRhX2RhdGE3LmNzdiIpLAogICAgICAgICAgICAgICAgICAgICAgcHJvZ3Jlc3MgPSBGQUxTRSwKICAgICAgICAgY29sX3R5cGVzID0gY29scygKICAgICAgICAgICAgICAgICAgICAgICAgc2NyaXB0X2lkID0gY29sX2ludGVnZXIoKSwKICAgICAgICAgICAgICAgICAgICAgICAgaW1kYl9pZCA9IGNvbF9jaGFyYWN0ZXIoKSwKICAgICAgICAgICAgICAgICAgICAgICAgdGl0bGUgPSBjb2xfY2hhcmFjdGVyKCksCiAgICAgICAgICAgICAgICAgICAgICAgIHllYXIgPSBjb2xfaW50ZWdlcigpLAogICAgICAgICAgICAgICAgICAgICAgICBncm9zcyA9IGNvbF9pbnRlZ2VyKCksCiAgICAgICAgICAgICAgICAgICAgICAgIGxpbmVzX2RhdGEgPSBjb2xfY2hhcmFjdGVyKCkKICAgICAgICAgICAgICAgICAgICAgICAgKSkgJT4lCiAgbXV0YXRlKHRpdGxlID0gaWNvbnYodGl0bGUsImxhdGluMSIsICJVVEYtOCIpKSAtPiBtZXRhX2RhdGEKCm1ldGFfZGF0YSAlPiUKICBnbGltcHNlKCkKCmBgYAoKIyMjIyBDb21iaW5hbmRvIERhZG9zIE9yaWdpbmFpcwoKYGBge3J9CmxlZnRfam9pbihjaGFyYWN0ZXJzX2xpc3QsIAogICAgICAgICAgbWV0YV9kYXRhLCAKICAgICAgICAgIGJ5PWMoInNjcmlwdF9pZCIpKSAlPiUKICBncm91cF9ieSh0aXRsZSwgeWVhcikgJT4lCiAgZHJvcF9uYShncm9zcykgJT4lCiAgdW5ncm91cCgpIC0+IHNjcmlwdHNfZGF0YQoKc2NyaXB0c19kYXRhICU+JQogIGdsaW1wc2UoKQpgYGAKCmBgYHtyfQpzY3JpcHRzX2RhdGEgJT4lCiAgbXV0YXRlKGZlbV93b3JkcyA9IGlmZWxzZShnZW5kZXIgPT0gImYiLHdvcmRzLDApLAogICAgICAgICBtYW5fd29yZHMgPSBpZmVsc2UoZ2VuZGVyID09ICJtIix3b3JkcywwKSkgJT4lCiAgZ3JvdXBfYnkodGl0bGUsIHllYXIpICU+JQogIG11dGF0ZSh0b3RhbF9mZW1fd29yZHMgPSBzdW0oZmVtX3dvcmRzKSwKICAgICAgICAgdG90YWxfbWFuX3dvcmRzID0gc3VtKG1hbl93b3JkcykpICU+JQogIGZpbHRlcih0b3RhbF9mZW1fd29yZHMgIT0gIDApICU+JQogIGZpbHRlcih0b3RhbF9tYW5fd29yZHMgIT0gIDApICU+JQogICAgbXV0YXRlKGZfbV9yYXRpbyA9IHN1bShnZW5kZXIgPT0gImYiKS9zdW0oZ2VuZGVyID09ICJtIiksCiAgICAgICAgICAgZl9tX3dvcmRyYXRpbyA9IHRvdGFsX2ZlbV93b3Jkcy90b3RhbF9tYW5fd29yZHMpICU+JQogIHVuZ3JvdXAoKSAgLT4gc2NyaXB0c19kYXRhCgpzY3JpcHRzX2RhdGEgJT4lCiAgc2VsZWN0KHRpdGxlLAogICAgICAgICB5ZWFyLAogICAgICAgICBmX21fcmF0aW8sCiAgICAgICAgIGZfbV93b3JkcmF0aW8pICU+JQogIHNhbXBsZV9uKDEwKQpgYGAKCmBgYHtyfQpzdW1tYXJ5KHNjcmlwdHNfZGF0YSRmX21fd29yZHJhdGlvKQpgYGAKCgojIyBGZW1hbGUvTWFsZSBXb3JkIFJhdGlvCgpgYGB7cn0Kc2NyaXB0c19kYXRhICU+JQogIGdyb3VwX2J5KHRpdGxlLHllYXIpICU+JQogIHVuaXF1ZSgpICU+JQogIGdncGxvdChhZXMoeD1mX21fd29yZHJhdGlvLAogICAgICAgICAgICAgeT0oLi5jb3VudC4uKS9zdW0oLi5jb3VudC4uKSkpICsKICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IDEsCiAgICAgICAgICAgICAgICAgYm91bmRhcnkgPSAwLAogICAgICAgICAgICAgICAgIGZpbGwgPSAiZ3JleSIsCiAgICAgICAgICAgICAgICAgY29sb3IgPSAiYmxhY2siKQpgYGAKCmBgYHtyfQpzY3JpcHRzX2RhdGEgJT4lCiAgZ3JvdXBfYnkodGl0bGUseWVhcikgJT4lCiAgdW5pcXVlKCkgJT4lCiAgZ2dwbG90KGFlcyh4PSIiLCAKICAgICAgICAgICAgIHk9d29yZHMpKSArCiAgZ2VvbV92aW9saW4oZmlsbD0iZ3JleSIsCiAgICAgICAgICAgICAgIHdpZHRoPTAuNSkKYGBgCgoKIyMgRmVtYWxlL01hbGUgUmF0aW8gCgpgYGB7cn0Kc2NyaXB0c19kYXRhICU+JQogIGdyb3VwX2J5KHRpdGxlLHllYXIpICU+JQogIHVuaXF1ZSgpICU+JQogIGdncGxvdChhZXMoeD1mX21fcmF0aW8sCiAgICAgICAgICAgICB5PSguLmNvdW50Li4pL3N1bSguLmNvdW50Li4pKSkgKwogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMC4xLAogICAgICAgICAgICAgICAgIGJvdW5kYXJ5ID0gMCwKICAgICAgICAgICAgICAgICBmaWxsID0gImdyZXkiLAogICAgICAgICAgICAgICAgIGNvbG9yID0gImJsYWNrIikKYGBgCgpgYGB7cn0Kc2NyaXB0c19kYXRhICU+JQogIGdyb3VwX2J5KHRpdGxlLHllYXIpICU+JQogIHVuaXF1ZSgpICU+JQogIGdncGxvdChhZXMoeD0iIiwgCiAgICAgICAgICAgICB5PWZfbV9yYXRpbykpICsKICBnZW9tX3Zpb2xpbihmaWxsPSJncmV5IiwKICAgICAgICAgICAgICAgd2lkdGg9MC41KQpgYGAKCiMjIE1vdmllIFllYXIgCgpgYGB7cn0Kc2NyaXB0c19kYXRhICU+JQogIGdyb3VwX2J5KHRpdGxlLHllYXIpICU+JQogIHVuaXF1ZSgpICU+JQogIGdncGxvdChhZXMoeD15ZWFyKSkgKwogIGdlb21fYmFyKGZpbGwgPSAiZ3JleSIsCiAgICAgICAgICAgY29sb3IgPSAiYmxhY2siKQpgYGAKCmBgYHtyfQpzY3JpcHRzX2RhdGEgJT4lCiAgZ3JvdXBfYnkodGl0bGUseWVhcikgJT4lCiAgdW5pcXVlKCkgJT4lCiAgZ2dwbG90KGFlcyh4PSIiLCAKICAgICAgICAgICAgIHk9eWVhcikpICsKICBnZW9tX3Zpb2xpbihmaWxsPSJncmV5IiwKICAgICAgICAgICAgICAgd2lkdGg9MC41KQpgYGAKCiMjIEdyb3NzIAoKYGBge3J9CnNjcmlwdHNfZGF0YSAlPiUKICBncm91cF9ieSh0aXRsZSx5ZWFyKSAlPiUKICB1bmlxdWUoKSAlPiUKICBnZ3Bsb3QoYWVzKHg9Z3Jvc3MsCiAgICAgICAgICAgICB5PSguLmNvdW50Li4pL3N1bSguLmNvdW50Li4pKSkgKwogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gNTAsCiAgICAgICAgICAgICAgICAgYm91bmRhcnkgPSAwLAogICAgICAgICAgICAgICAgIGZpbGwgPSAiZ3JleSIsCiAgICAgICAgICAgICAgICAgY29sb3IgPSAiYmxhY2siKQpgYGAKCmBgYHtyfQpzY3JpcHRzX2RhdGEgJT4lCiAgZ3JvdXBfYnkodGl0bGUseWVhcikgJT4lCiAgdW5pcXVlKCkgJT4lCiAgZ2dwbG90KGFlcyh4PSIiLCAKICAgICAgICAgICAgIHk9Z3Jvc3MpKSArCiAgZ2VvbV92aW9saW4oZmlsbD0iZ3JleSIsCiAgICAgICAgICAgICAgIHdpZHRoPTAuNSkKYGBgCgojIyBTY2FsaW5nIERhdGEKCmBgYHtyfQpzY3JpcHRzX2RhdGEgJT4lCiAgZ3JvdXBfYnkodGl0bGUpICU+JQogIHNsaWNlKDEpICU+JQogIHVuaXF1ZSgpICU+JQogIHVuZ3JvdXAoKSAlPiUKICBzZWxlY3QodGl0bGUsCiAgICAgICAgIGdyb3NzLAogICAgICAgICBmX21fcmF0aW8sCiAgICAgICAgIGZfbV93b3JkcmF0aW8pIC0+IGRhdGEKCnNlbGVjdChkYXRhLCAtdGl0bGUpICU+JQptdXRhdGVfYWxsKGZ1bnMoc2NhbGUpKSAtPiBzY2FsZWRfZGF0YQoKc2NhbGVkX2RhdGEgJT4lIAogIHNhbXBsZV9uKDEwKQpgYGAKCiMgIE7Dum1lcm8gSyDDs3RpbW8gCgojIyBHQVAgc3RhdGlzdGljCgpBIEdBUCBjb21wYXJhIGEgc29sdcOnw6NvIGRvIGFncnVwYW1lbnRvIGNvbSBjYWRhIGsgY29tIGEgc29sdcOnw6NvIGVtIHVtIGRhdGFzZXQgb25kZSBuw6NvIGjDoSBlc3RydXR1cmEgZGUgZ3J1cG9zLiAKCmBgYHtyfQpwbG90X2NsdXNnYXAgPSBmdW5jdGlvbihjbHVzZ2FwLCB0aXRsZT0iR2FwIFN0YXRpc3RpYyBjYWxjdWxhdGlvbiByZXN1bHRzIil7CiAgICByZXF1aXJlKCJnZ3Bsb3QyIikKICAgIGdzdGFiID0gZGF0YS5mcmFtZShjbHVzZ2FwJFRhYiwgaz0xOm5yb3coY2x1c2dhcCRUYWIpKQogICAgcCA9IGdncGxvdChnc3RhYiwgYWVzKGssIGdhcCkpICsgZ2VvbV9saW5lKCkgKyBnZW9tX3BvaW50KHNpemU9NSkKICAgIHAgPSBwICsgZ2VvbV9lcnJvcmJhcihhZXMoeW1heD1nYXArU0Uuc2ltLCB5bWluPWdhcC1TRS5zaW0pLCB3aWR0aCA9IC4yKQogICAgcCA9IHAgKyBnZ3RpdGxlKHRpdGxlKQogICAgcmV0dXJuKHApCn0KYGBgCgpgYGB7cn0KZ2FwcyA8LSBzY2FsZWRfZGF0YSAlPiUgCiAgICBjbHVzR2FwKEZVTiA9IGttZWFucywKICAgICAgICAgICAgbnN0YXJ0ID0gMjAsCiAgICAgICAgICAgIEsubWF4ID0gOCwKICAgICAgICAgICAgQiA9IDIwMCwKICAgICAgICAgICAgaXRlci5tYXg9MzApCmBgYAoKYGBge3J9CnBsb3RfY2x1c2dhcChnYXBzKQpgYGAKCiogMyBvdSA2IGdydXBvcyBwYXJlY2UgYXByb3BpYWRvLCBtYXMgY29tbyA2IMOpIHByZWNlZGlkbyBwb3IgdW1hIHPDqXJpZSBkZSBxdWVkYXMgMyBzZXJpYSB1bWEgbWVsaG9yIG9ww6fDo28uCgojIyBFbGJvdyBNZXRob2QKCmBgYHtyfQpzZXQuc2VlZCgxMjMpCiMgQ29tcHV0ZSBhbmQgcGxvdCB3c3MgZm9yIGsgPSAyIHRvIGsgPSAxNS4Kay5tYXggPC0gMTUKCndzcyA8LSBzYXBwbHkoMTprLm1heCwgCiAgICAgICAgICAgICAgZnVuY3Rpb24oayl7a21lYW5zKHNjYWxlZF9kYXRhLCBrLCBuc3RhcnQ9NTAsaXRlci5tYXggPSAxNSApJHRvdC53aXRoaW5zc30pCnBsb3QoMTprLm1heCwgd3NzLAogICAgIHR5cGU9ImIiLCBwY2ggPSAxOSwgZnJhbWUgPSBGQUxTRSwgCiAgICAgeGxhYj0iTnVtYmVyIG9mIGNsdXN0ZXJzIEsiLAogICAgIHlsYWI9IlRvdGFsIHdpdGhpbi1jbHVzdGVycyBzdW0gb2Ygc3F1YXJlcyIpCmBgYAoKKiBQZWxvIEVsYm93IG1ldGhvZCAzIHBhcmVjZSBzZXIgdW0gYm9tIG7Dum1lcm8gZGUgZ3J1cG9zIGRldmlkbyDDoCBxdWVkYSBkZSAzIHBhcmEgNC4KCiMjIEJheWVzaWFuIEluZm9ybWF0aW9uIENyaXRlcmlvbgoKYGBge3IgZWNobz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0KZF9jbHVzdCA8LSBNY2x1c3QoYXMubWF0cml4KHNjYWxlZF9kYXRhKSwgRz0xOjE1LCAKICAgICAgICAgICAgICAgICAgbW9kZWxOYW1lcyA9IG1jbHVzdC5vcHRpb25zKCJlbU1vZGVsTmFtZXMiKSkKCnBsb3QoZF9jbHVzdCRCSUMpCmBgYAoKKiBWaXN1YWxtZW50ZSBLPSAyIGUgSyA9IDMgcmVwcmVzZW50YW0gbyBnYW5obyBtYWlzIHNpZ25pZmljYXRpdm8gZW0gdGVybW9zIGRlIEJJQyAoQmF5ZXNpYW4gSW5mb3JtYXRpb24gQ3JpdGVyaW9uKSAKCiMjIEh1YmVydCBJbmRleCBlIEQgSW5kZXgKCmBgYHtyfQpuYiA8LSBOYkNsdXN0KHNjYWxlZF9kYXRhLCBkaXNzPU5VTEwsIGRpc3RhbmNlID0gImV1Y2xpZGVhbiIsIAogICAgICAgICAgICAgIG1pbi5uYz0yLCBtYXgubmM9NSwgbWV0aG9kID0gImttZWFucyIsIAogICAgICAgICAgICAgIGluZGV4ID0gImFsbCIsIGFscGhhQmVhbGUgPSAwLjEpCmhpc3QobmIkQmVzdC5uY1sxLF0sIGJyZWFrcyA9IG1heChuYS5vbWl0KG5iJEJlc3QubmNbMSxdKSkpCmBgYAoKKiBPIMOtbmRpY2UgZGUgSHViZXJ0IGUgbyDDrW5kaWNlIEQgc3VnZXJlbSBLID0gMyAgY29tbyBhIG1lbGhvciBzb2x1w6fDo28KCiMgSy1NZWFucyAKCioqKioKCiMjIENsdXN0ZXJpbmcKCmBgYHtyfQpuX2NsdXN0ZXJzID0gMwoKc2NhbGVkX2RhdGEgJT4lCiAgICBrbWVhbnMobl9jbHVzdGVycywgaXRlci5tYXggPSAxMDAsIG5zdGFydCA9IDIwKSAtPiBrbQoKcCA8LSBhdXRvcGxvdChrbSwgZGF0YT1zY2FsZWRfZGF0YSwgZnJhbWUgPSBUUlVFKSAgCgpnZ3Bsb3RseShwKQoKYGBgCgoqIMOJIHBvc3PDrXZlbCB2ZXIgb3MgMyBncnVwb3Mgbml0aWRhbWVudGUgZGlzdGludG9zLCBwb3IgbWVpbyBkZSB1bSB6b29tIHBlcmNlYmUtc2UgcXVlIGVtYm9yYSBvIGdydXBvIDEgZSBvIGdydXBvIDMgZXN0ZWphbSBwcsOzeGltb3MgbyBvdmVybGFwIMOpIGJhc2ljYW1lbnRlIGluZXhpc3RlbnRlLgoKYGBge3IsIHdhcm5pbmc9RkFMU0V9CnJvdy5uYW1lcyhzY2FsZWRfZGF0YSkgPC0gZGF0YSR0aXRsZQoKdG9jbHVzdCA8LSBzY2FsZWRfZGF0YSAlPiUgCiAgICByb3duYW1lc190b19jb2x1bW4odmFyID0gInRpdGxlIikgCgprbSA9IHRvY2x1c3QgJT4lIAogICAgc2VsZWN0KC10aXRsZSkgJT4lIAogICAga21lYW5zKGNlbnRlcnMgPSBuX2NsdXN0ZXJzLCBpdGVyLm1heCA9IDEwMCwgbnN0YXJ0ID0gMjApCgprbSAlPiUgCiAgICBhdWdtZW50KHRvY2x1c3QpICU+JSAKICAgIGdhdGhlcihrZXkgPSAidmFyacOhdmVsIiwgdmFsdWUgPSAidmFsb3IiLCAtdGl0bGUsIC0uY2x1c3RlcikgJT4lIAogICAgZ2dwbG90KGFlcyh4ID0gYHZhcmnDoXZlbGAsIHkgPSB2YWxvciwgZ3JvdXAgPSB0aXRsZSwgY29sb3VyID0gLmNsdXN0ZXIpKSArIAogICAgZ2VvbV9wb2ludChhbHBoYSA9IDAuMikgKyAKICAgIGdlb21fbGluZShhbHBoYSA9IC41KSArIAogICAgZmFjZXRfd3JhcCh+IC5jbHVzdGVyKSArCiAgICBjb29yZF9mbGlwKCkKCmBgYAoKKiBHcnVwbyAxICoqWWVzLCBXZSBDYW4qKgogICAgKiBNZW5vciBGYXR1cmFtZW50byAKICAgICogTWFpcyBkaWFsw7NnbyBwYXJhIGFzIG11bGhlcmVzIAogICAgKiBNYWlvciB0YXhhIGRlIHBlcnNvbmFnZW5zIGZlbWluaW5vcwoKKiBHcnVwbyAyIC0gKipJdCdzIGEgbWFuJ3Mgd29ybGQqKiAgIAogICAgKiBNYWlvciBmYXR1cmFtZW50byBlbnRyZSB0b2RvcwogICAgKiBNZW5vciB0YXhhIGRlIGRpYWzDs2dvIHBhcmEgYXMgbXVsaGVyZXMKICAgICogTWVub3IgdGF4YSBkZSBwZXJzb25hZ2VucyBmZW1pbmlub3MKCiogR3J1cG8gMyAtICoqU2l0dGluZyBvbiB0aGUgRmVuY2UqKgogICAgKiBNZWRpYW5vIGVtIHRlcm1vcyBkZSBkaWFsw7NnbywgcGVyc29uYWdlbnMgZSBmYXR1cmFtZW50byAKCiMjIFNpbGhvdWV0dGUKCmBgYHtyfQpkaXN0cyA9IHNjYWxlZF9kYXRhICU+JSAKICBkaXN0KCkKCnNjYWxlZF9kYXRhICU+JQogICAga21lYW5zKDMsIGl0ZXIubWF4ID0gMTAwLCBuc3RhcnQgPSAyMCkgLT4ga20KCgpzaWxob3VldHRlKGttJGNsdXN0ZXIsIGRpc3RzKSAlPiUKICAgcGxvdChjb2wgPSBSQ29sb3JCcmV3ZXI6OmJyZXdlci5wYWwoNCwgIlNldDIiKSxib3JkZXI9TkEpCmBgYAoKKiBPIHZhbG9yIGRlIDAuNiBkYSBzaWxodWV0YSBzaWduaWZpY2EgcXVlIGEgbm9zc2EgY2x1c3Rlcml6YcOnw6NvIGZvaSByYXpvw6F2ZWwuIOODvijijJDilqBf4pagKeODjuKZqgoK